home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
WAFPEGTP
/
TRIMLOG.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-16
|
6KB
|
234 lines
{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 64000,32000,32000}
program trimlog;
{
takes an input file and trims the start to a length specified
on the command line as a parameter.
useful for trimming log files
Copyright (C) 1992 Dr Ross Lazarus
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1.0, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Dr Ross Lazarus is the original copyright holder of this code.
Email: rossl@gmu.wh.su.edu.au
Mail: Department of Community Medicine,
Westmead Hospital
Westmead, NSW 2145
Australia
Fax: (+61 2) 689 1049
rml January 1993
}
uses dos,crt;
const
prog = 'TrimLog';
ver = '0.003,941601';
bufsize = 16767; {**** can be bigger if you want... ****}
tempext = '.$`~'; { an unlikely file extension }
trimlength : longint = 32; { default trimmed size in kBytes }
type
tbuf = array[1..bufsize] of byte;
var
ifile,ofile : file ;
iname,oname,homedir,logdir,logfile,logext : string;
space,sifile : longint;
logdrive : integer;
ibuf : tbuf;
i : word;
Function SysDate : string;
Var
d,m,y,dow : word;
Dd, Mm, Yy : String[4];
DT : string;
Begin
getdate(y,m,d,dow);
Str(d:2, dd);
Str(m:2, mm);
Str(y:4, Yy);
DT := Dd + '/' + Mm + '/' +Yy;
for i := 1 to 10 do
if DT[I] = ' ' then
DT[I] := '0';
SysDate := DT
End;
Function SysTime : String;
Var
Hh, Mm, Ss : String[2];
h,m,s,s100 : word;
Begin
gettime(h,m,s,s100);
Str(H:2,hh);
Str(m:2,mm);
Str(s:2,ss);
if Hh[1] = ' ' then Hh[1] := '0';
if Mm[1] = ' ' then Mm[1] := '0';
if Ss[1] = ' ' then Ss[1] := '0';
SysTime := Hh + ':' + Mm + ':' + Ss;
End;
procedure explain;
{
give instructions and halt
}
begin
writeln(prog,' ',ver,', rossl@gmu.wh.su.edu.au');
writeln('**ERROR** ',sysdate,' at ',systime,' Probable Parameter error');
writeln('Need an input file path as the first parameter');
writeln('and a maximum length as the second');
writeln('eg trimlog c:\waffle\admin\uucico 32');
writeln('will trim uucico to a maximum length of 32k');
writeln('by discarding old material from the top of the file');
writeln('(c) Dr Ross Lazarus. This is FREE software. No fee may be charged');
writeln('for installation or use. Distribute for direct (materials) cost only.');
writeln('Please notify the author urgently if anyone ripped you off by charging');
writeln('any fee other than actual distribution costs.');
delay(1000);
chdir(homedir);
halt(1);
end; { explain }
procedure init;
{
check params
}
begin
if (paramcount = 0) then
explain;
if (paramcount > 1) then
begin
val(paramstr(2),trimlength,i);
if (i <> 0) then
begin
writeln('**ERROR - Non integer trim length specified (',paramstr(2),')**');
explain;
end;
end;
iname := paramstr(1);
{$i-}
assign(ifile,iname);
reset(ifile,1);
{$i+}
i := ioresult;
if (i <> 0) then
begin
writeln('**ERROR - Input file ',iname,' could not be opened**');
explain;
end;
fsplit(iname,logdir,logfile,logext);
{$i-}
chdir(logdir);
{$i+}
i := ioresult;
if (i <> 0) then
begin
close(ifile);
writeln('***ERROR - unable to change directory to ',logdir);
explain;
end;
space := diskfree(0);
if trimlength > space then
begin
close(ifile);
writeln('***ERROR - Insufficient disk space available to trim file ',iname);
writeln('Found ',space,', need ',trimlength);
explain;
end;
{$i-}
assign(ofile,logdir + logfile + tempext);
rewrite(ofile,1);
{$i+}
i := ioresult;
if (i <> 0) then
begin
close(ifile);
writeln('***ERROR - unable to open outfile ',logdir + logfile + tempext);
explain;
end;
end; { init }
procedure docopy;
{
files are open
copy trimlength bytes from end of ifile to ofile
}
var
toread,read : word;
fs,waste : longint;
begin
fs := filesize(ifile);
waste := fs - 1024*trimlength; { header length to trash }
if (waste > 0) then
begin
repeat { read all the stuff we need to delete to nowhere }
if waste > sizeof(ibuf) then
toread := sizeof(ibuf)
else
toread := waste;
blockread(ifile,ibuf,toread,read);
dec(waste,read);
until (waste <= 0);
repeat { now copy the rest to our output file }
blockread(ifile,ibuf,sizeof(ibuf),read);
blockwrite(ofile,ibuf,read);
until read = 0;
{$i-}
close(ifile);
i := ioresult;
close(ofile);
i := ioresult;
erase(ifile);
i := ioresult;
rename(ofile,iname);
i := ioresult;
{$i-};
writeln(prog,' ',sysdate,' at ',systime,' --> ',fs - 1024*trimlength,' bytes trimmed from file ',iname);
end
else
begin
writeln(prog,' ',sysdate,' at ',systime,' --> ',' Nothing done, ',iname,' only ',filesize(ifile) div 1024,'k long');
close(ifile);
close(ofile);
erase(ofile);
end;
end;
begin { main }
getdir(0,homedir);
assign(input,'');
reset(input);
assign(output,'');
rewrite(output);
init;
docopy;
chdir(homedir);
end.
{trimlog.pas}